unit GLS.Teleport;
(*
   TGLTeleport
*)

interface

uses
  System.Classes,
  Winapi.OpenGL,

  GLS.Scene,
  GLS.State,
  GLS.VectorTypes,
  GLS.VectorGeometry,
  GLS.Texture,
  Vcl.Graphics,
  GLS.RenderContextInfo,
  GLS.PersistentClasses,
  GLS.Material;

type
  TGLTeleport = class(TGLSceneObject)
  private
    FRendering: Boolean;
    FTeleportObject: TGLBaseSceneObject;
  protected
    procedure ClearZBufferArea;
  public
    Width, Height: Single;
    constructor Create(AOwner: TComponent); override;
    procedure DoRender(var rci: TGLRenderContextInfo;
      renderSelf, renderChildren: Boolean); override;
    procedure BuildList(var rci: TGLRenderContextInfo); override;
    procedure SetTeleportObject(const val: TGLBaseSceneObject);
  end;

//================================================
implementation
//================================================

//
// constructor
//
constructor TGLTeleport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 1;
  Height := 1;
  ObjectStyle := ObjectStyle + [osDirectDraw];
  Material.FrontProperties.Diffuse.Initialize(VectorMake(1, 1, 1, 0.1));
  Material.BlendingMode := bmTransparency;
end;

//
// DoRender
//
procedure TGLTeleport.DoRender(var rci: TGLRenderContextInfo;
  renderSelf, renderChildren: Boolean);

  function col2vec(col: cardinal): TGLVector;
  const
    c = 1 / 255;
  begin
    col := colortorgb(col);
    setvector(result, (col and 255) * c, ((col shr 8) and 255) * c,
      ((col shr 16) and 255) * c, 1);
  end;

var
  clipPlane: TDoubleHmgPlane;

begin
  if (FRendering) or (not Assigned(FTeleportObject)) then
    Exit;
  FRendering := True;
  try
    if VectorDotProduct(VectorSubtract(rci.cameraPosition, AbsolutePosition),
      AbsoluteDirection) > 0 then
    begin
      glPushAttrib(GL_ENABLE_BIT);
      glClearStencil(0);
      glClear(GL_STENCIL_BUFFER_BIT);
      glEnable(GL_STENCIL_TEST);
      glStencilFunc(GL_ALWAYS, 1, 1);
      glStencilOp(GL_REPLACE, GL_ZERO, GL_REPLACE);
      glDepthMask(0);
      BuildList(rci);
      glDepthMask(1);
      glStencilFunc(GL_EQUAL, 1, 1);
      glStencilOp(GL_KEEP, GL_KEEP, GL_KEEP);
      ClearZBufferArea;
      glPushMatrix;

      glLoadMatrixf(@Scene.CurrentBuffer.BaseProjectionMatrix);

      glDisable(GL_CULL_FACE);
      glEnable(GL_CLIP_PLANE0);
      SetPlane(clipPlane, PlaneMake(AffineVectorMake(AbsolutePosition),
        VectorNegate(AffineVectorMake(AbsoluteDirection))));
      glClipPlane(GL_CLIP_PLANE0, @clipPlane);
      if FTeleportObject.Parent <> nil then
        glMultMatrixf(PGLFloat(FTeleportObject.Parent.AbsoluteMatrixAsAddress));
      glMultMatrixf(PGLFloat(FTeleportObject.LocalMatrix));
      FTeleportObject.DoRender(rci, renderSelf, FTeleportObject.Count > 0);

      glPopMatrix;
      glPopAttrib;
      if renderSelf then
      begin
        Material.Apply(rci);
        repeat
          BuildList(rci);
        until not Material.UnApply(rci);
      end;
    end;
  finally
    FRendering := False;
  end;
end;

//
// Geometry - plane
//
procedure TGLTeleport.BuildList(var rci: TGLRenderContextInfo);
var
  hw, hh: Single;
begin
  hw := Width * 0.5;
  hh := Height * 0.5;
  glNormal3fv(@ZVector);
  glBegin(GL_QUADS);
  glVertex3f(hw, hh, 0);
  glVertex3f(-hw, hh, 0);
  glVertex3f(-hw, -hh, 0);
  glVertex3f(hw, -hh, 0);
  glEnd;
end;

//
// ClearZBufferArea
//
procedure TGLTeleport.ClearZBufferArea;
var
  worldMat: TGLMatrix;
  p: TAffineVector;
begin
  with Scene.CurrentBuffer do
  begin
    glPushMatrix;
    worldMat := Self.AbsoluteMatrix;
    glMatrixMode(GL_PROJECTION);
    glPushMatrix;
    glLoadIdentity;
    glOrtho(0, Width, 0, Height, 1, -1);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
    glDepthFunc(GL_ALWAYS);
    glColorMask(0, 0, 0, 0);
    glBegin(GL_QUADS);
    p := WorldToScreen(VectorTransform(AffineVectorMake(Self.Width * 0.5,
      Self.Height * 0.5, 0), worldMat));
    glVertex3f(p.X, p.Y, 0.999);
    p := WorldToScreen(VectorTransform(AffineVectorMake(-Self.Width * 0.5,
      Self.Height * 0.5, 0), worldMat));
    glVertex3f(p.X, p.Y, 0.999);
    p := WorldToScreen(VectorTransform(AffineVectorMake(-Self.Width * 0.5,
      -Self.Height * 0.5, 0), worldMat));
    glVertex3f(p.X, p.Y, 0.999);
    p := WorldToScreen(VectorTransform(AffineVectorMake(Self.Width * 0.5,
      -Self.Height * 0.5, 0), worldMat));
    glVertex3f(p.X, p.Y, 0.999);
    glEnd;
    glColorMask(1, 1, 1, 1);
    glDepthFunc(GL_LESS);
    glMatrixMode(GL_PROJECTION);
    glPopMatrix;
    glMatrixMode(GL_MODELVIEW);
    glPopMatrix;
  end;
end;

//
// SetTeleportObject
//
procedure TGLTeleport.SetTeleportObject(const val: TGLBaseSceneObject);
begin
  if FTeleportObject <> val then
  begin
    if Assigned(FTeleportObject) then
      FTeleportObject.RemoveFreeNotification(Self);
    FTeleportObject := val;
    if Assigned(FTeleportObject) then
      FTeleportObject.FreeNotification(Self);
    NotifyChange(Self);
  end;
end;

end.
